VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "NumtoText"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Dim sErrString$
Dim Count As Boolean

Public Function fChange$(ByVal sNumber$, Optional ByVal bUseForChecks As Boolean, Optional ByVal sCurrency As String)
Dim nLength%: Dim nCounter%: Dim nCounter2%
Dim nDecPlace%
Dim sChar$: Dim sStrNum$
Dim dNum#: Dim dFixedNum#
Dim Remainder&
Dim GetRem: Dim NrOver3
Dim WrdCol As New Collection

On Error GoTo DoError
If sNumber = "" Then Exit Function
'initialize placeholder variable
nDecPlace = 0
'convert amount to number without any cents
dNum = Fix(sNumber)
'get length of number
'have to use str because anyother data type returns nr of bytes, not length
nLength = Len(Str(dNum)) - 1

'get how many cents there are
GetRem = CDbl(sNumber)
Remainder = (GetRem - Fix(GetRem)) * 100
'place leading zeros in front of amount if neccessary
'so that amount is is in multiple of three.
NrOver3 = nLength Mod 3
dNum = CDbl(sNumber)
dFixedNum = Fix(dNum)
sStrNum = CStr(dFixedNum)
If NrOver3 > 0 Then
    For nCounter = (3 - NrOver3) To 1 Step -1
        sStrNum = "0" & sStrNum
    Next nCounter
End If
'reset length after adding leading zero's
nLength = Len(sStrNum)
'break number into groups of three and send to
'converting routine
For nCounter = nLength To 1 Step -3
    nDecPlace = nDecPlace + 1
    sChar = ""
        For nCounter2 = nCounter - 2 To nCounter Step 1
        sChar = sChar & Mid(sStrNum, nCounter2, 1)
    Next nCounter2
    'add converted number to the collection
    WrdCol.Add NumberToWord(sChar, nDecPlace)
Next nCounter
'covert the cents into words
Dim X
Dim Centss
    For X = WrdCol.Count To 1 Step -1
        fChange = fChange & " " & WrdCol(X)
    Next X
    X = (NumberToWord(CStr(Remainder), 1))

If Remainder > 0 Then

    
    If Remainder = 1 Then
        Centss = " and " & X & "Cent only."
    Else
        Centss = " and " & X & "Cents only."
    End If
    
Else
    Centss = " only."
End If
If fChange = " " Then fChange = "Zero "

If IsMissing(bUseForChecks) Then bUseForChecks = False
If sCurrency = "" Then sCurrency = "Dollar"
If bUseForChecks = True Then
    If fChange = " One " Then
        fChange = fChange & sCurrency & Centss
    Else
        fChange = fChange & sCurrency & "s" & Centss
    End If
Else
    If Remainder > 0 Then
        fChange = fChange & "and " & X & "Hundredths."
    End If
    
    
End If
    

Exit_Function:
    Exit Function
DoError:
    Select Case Err.Number
        Case 13
            
            sErrString = "Unable to evaluate Number"
       
            MsgBox sErrString, vbCritical + vbExclamation, "Sorry."
        Case Else
            
            sErrString = Err.Description & "  Error Number is: " & Err.Number
            MsgBox sErrString, vbCritical + vbExclamation, "Unknown Error"
            
     End Select
    
          
        
End Function
Private Function NumberToWord$(ByVal sStrNum$, ByVal TimesThrough%)
Dim NumArray: Dim TeenArray: Dim TenArray: Dim UnitArray
Dim nCounter%: Dim nLength%: Dim nChar%: Dim nDecPlace%
Dim NrOver3
Dim DoDigit As Boolean

NumArray = Array("One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine")
TeenArray = Array("Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
TenArray = Array("", "Twenty ", "Thirty ", "Forty ", "Fifty ", "Sixty ", "Seventy ", "Eighty ", "Ninety ")
UnitArray = Array("", "Thousand", "Million", "Billion", "Trillion")

nLength = Len(sStrNum)
NrOver3 = nLength Mod 3
If NrOver3 > 0 Then
    For nCounter = (3 - NrOver3) To 1 Step -1
        sStrNum = "0" & sStrNum
    Next nCounter
End If
nLength = Len(sStrNum)

nDecPlace = 4
DoDigit = True
For nCounter = 1 To nLength
    nDecPlace = nDecPlace - 1
    nChar = Mid(sStrNum, nCounter, 1)
    If nChar > 0 Then
    Select Case nDecPlace
        Case 3
        If Val(Mid(sStrNum, 2, 1)) > 1 Then
            NumberToWord = NumArray(nChar - 1) & " Hundred and "
        Else
            NumberToWord = NumArray(nChar - 1) & " Hundred "
        End If
        Case 2
           
            If nChar = 1 Then
                NumberToWord = NumberToWord & TeenArray(Mid(sStrNum, nCounter + 1, 1)) & " " & UnitArray(TimesThrough - 1)
                DoDigit = False
            Else
                
                NumberToWord = NumberToWord & TenArray(nChar - 1)
            End If
        Case 1
            If DoDigit = True Then
                NumberToWord = NumberToWord & NumArray(nChar - 1) & " " & UnitArray(TimesThrough - 1)
            End If
    End Select
    End If
Next nCounter
End Function

